home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / AlphaLite.6.52 / Tcl / SystemCode / fill.tcl < prev    next >
Text File  |  1997-03-25  |  12KB  |  400 lines
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 3/7/95 {7:49:47 pm} 
  6. #                                last update: 16/5/96 
  7. #  Author: Vince Darley
  8. #  E-mail: <mailto:vince@das.harvard.edu>
  9. #    mail: Division of Applied Sciences, Harvard University
  10. #          Oxford Street, Cambridge MA 02138, USA
  11. #     www: <http://www.fas.harvard.edu/~darley/>
  12. #  
  13. ####################################################################
  14.  
  15. ## 
  16.  # Here's a    brief explanation of the smart fillParagraph routines
  17.  # 
  18.  # 'fillParagraph'
  19.  #       If there's a    selection, then    fill all paragraphs    in that
  20.  #       selection. If not then fill the paragraph surrounding the
  21.  #       insertion point.    The    definition of a    'paragraph'    may    be
  22.  #       mode    dependent (see paraStart, paraFinish)
  23.  #       
  24.  # 'fillOneParagraph'
  25.  #       Fills the single    paragraph surrounding the insertion    point.
  26.  #       If called with parameter    '0', it    doesn't    bother to remember
  27.  #       where the insertion point was, which    makes multiple paragraph
  28.  #       fills quicker when called by    'fillParagraph'
  29.  #       
  30.  # 'rememberWhereYouAre'
  31.  #       Given the start of a    paragraph and the point    to remember,
  32.  #       this    creates    a record stored    in '__g_remember_pos' so that
  33.  #       the following function can find that    spot later,    even after
  34.  #       the paragraph has had space/tabs/new-lines meddled with.
  35.  #       
  36.  # 'goBackToWhereYouWere'
  37.  #       Given the beginning and end of a    selection, where the beginning
  38.  #       corresponds to a    previous call of 'rememberWhereYouAre',    this
  39.  #       procedure will move the insertion point to the correct place.
  40.  #       
  41.  # 'texParaCommands'
  42.  #       A variable containing the bulk of a regexp for paragraph
  43.  #       indicators in 'TeX' mode.
  44.  #       
  45.  # 'paraStart'
  46.  #       Finds the start of the paragraph    containing the insertion point.
  47.  #       
  48.  # 'paraFinish'
  49.  #       Finds the end of    the    paragraph containing the insertion point.
  50.  ##
  51.     
  52. proc fillParagraph {} {
  53.     if {[getPos] == [selEnd]} {
  54.         fillOneParagraph
  55.     } else {    
  56.         set start [getPos]
  57.         set end [selEnd]
  58.         set p $start
  59.         while { $p < $end && $p < [maxPos]} {
  60.             goto $p
  61.             set p [fillOneParagraph 0]
  62.         }
  63.         goto $start
  64.     }
  65. }
  66.  
  67. proc rememberWhereYouAre { startPara pos } {
  68.     global __g_remember_str
  69.     set srem [expr $pos -20 < $startPara ? $startPara : $pos - 20]
  70.     set __g_remember_str [quoteExpr2 [getText $srem $pos ]]
  71.     regsub -all "\[ \t\r\]+" $__g_remember_str {[ \t\r]+} __g_remember_str
  72. }
  73.  
  74. proc goBackToWhereYouWere { start end } {
  75.     global __g_remember_str
  76.     if { $__g_remember_str != "" } {
  77.         regexp -indices ".*(${__g_remember_str}).*" [getText $start $end] wholematch submatch
  78.         set p [expr [info exists submatch] ? \
  79.             [expr $start + 1 + [lindex $submatch 1]] : $end]
  80.         goto [expr $p >= $end ? $end -1 : $p]
  81.     } else {
  82.         goto $start
  83.     }
  84. }
  85.  
  86. ## 
  87.  # -------------------------------------------------------------------------
  88.  #     
  89.  #    "getLeadingIndent" --
  90.  #    
  91.  #     Find the indentation of the line containing 'pos',    and    convert    it
  92.  #     to    a minimal form of tabs followed    by spaces.    If 'size'
  93.  #     is    given, then    the    variable of    that name is set to    the    length of
  94.  #     the indent. Similarly 'halftab' can be set to half a tab.
  95.  # -------------------------------------------------------------------------
  96.  ##
  97. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  98.     # get the leading whitespace of the current line
  99.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  100.     
  101.     # convert it to minimal form: tabs then spaces, stored in 'front'
  102.     getWinInfo a
  103.     set sp [string range "              " 1 $a(tabsize) ]
  104.     regsub -all $sp [eval getText $res] "\t" front
  105.     regsub -all "\[ \]+\t" $front "\t" front
  106.     if { $size != "" } {
  107.         upvar $size ind
  108.         # get the length of the indent
  109.         regsub -all "\t" $front $sp lfront
  110.         set ind [string length $lfront]
  111.     }
  112.  
  113.     if { $halftab != "" } {
  114.         upvar $halftab ht
  115.         # get the length of half a tab
  116.         set ht [string range "            " 1 [expr $a(tabsize)/2]]
  117.     }
  118.     
  119.     return $front
  120. }
  121.  
  122. proc fillOneParagraph { {remember 1} } {
  123.     global leftFillColumn fillColumn doubleSpaces
  124.  
  125.     set pos [getPos]
  126.     
  127.     set start [paraStart $pos] 
  128.     set end [paraFinish $pos]
  129.     if $remember { rememberWhereYouAre $start $pos }
  130.  
  131.     # Get the leading whitespace of the current line and store length in 'left'
  132.     set front [getLeadingIndent $pos left]
  133.     # fill the text
  134.     regsub -all "\[ \t\r\]+" [string trim [getText $start $end]] " " text
  135.     # turn single spaces at end of sentences into double
  136.     if {$doubleSpaces} {regsub -all {(([^A-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  137. #     if {$doubleSpaces} {regsub -all {(([^A-Z@]|\\@)[.?!][])'"]?) } $text {\1  } text}
  138.  
  139.     # temporarily adjust the fillColumns
  140.     set ol $leftFillColumn
  141.     set or $fillColumn
  142.     set leftFillColumn 0
  143.     set fillColumn [expr $fillColumn - $left]
  144.         
  145.     # break and indent the paragraph
  146.     regsub -all "\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
  147.     
  148.     # don't replace if nothing's changed
  149.     if { "$text\r" != "\r[getText $start $end]" } {
  150.         replaceText $start $end "[string range $text 1 end]\r"
  151.         if $remember { goBackToWhereYouWere $start [expr $start + [string length $text]] }
  152.     }
  153.     
  154.     set leftFillColumn $ol
  155.     set fillColumn  $or
  156.     # in case we wish to fill a region
  157.     return $end
  158. }
  159.  
  160.  
  161. ## 
  162.  # -------------------------------------------------------------------------
  163.  # 
  164.  #    "paraStart"    -- "paraFinish"
  165.  # 
  166.  #     Newly simplified version with fewer regexp    '()' pairs.    Also I think
  167.  #     it    deals better with TeX comments than    the    old    regexp.
  168.  #     
  169.  #     "Start": It's pretty clear    for    non    TeX    modes how this works.  The only    
  170.  #     key is    that we    start at the beginning of the current line and look    back.  
  171.  #     We    then have a    quick check    for    whether    we found that very beginning (in 
  172.  #     which case    return it) or if not (in which case we have found the end of 
  173.  #     the previous paragraph) we move forward a line.
  174.  # 
  175.  #     "Finish": The only    addition is    the    need for an    additional check for
  176.  #     stuff which explicitly    ends lines.
  177.  #       
  178.  #    Results:
  179.  #     The start/finish position of the paragraph containing the given 'pos'
  180.  # 
  181.  # --Version--Author------------------Changes-------------------------------
  182.  #      1.1      <vince@das.harvard.edu> Cut down on '()' pairs
  183.  #    1.2     Vince - March '96          Better filling for TeX tables ('hline')
  184.  #    1.3     Johan Linde - May '96   Now sensitive to HTML elements
  185.  # -------------------------------------------------------------------------
  186.  ##
  187. proc paraStart {pos} {
  188.     global mode texParaCommands htmlParaCommands
  189.     if {$pos == [maxPos]} {incr pos -1}
  190.     set pos [lineStart $pos]
  191.     if { $mode == "TeX" || $mode == "Bib" } {
  192.         set startPara {^[ \t]*$|\\\\[ \t]*$|%.*$|\\h+line[ \t]*$|\$\$[ \t]*$|^[ \t]*(\\(}
  193.         append startPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  194.     } elseif {$mode == "HTML"} {
  195.         set startPara {^[ \t]*$|</?(}
  196.         append startPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  197.     } else {
  198.         set startPara {^([ \t]*|([\\%].*))$}
  199.     }
  200.     set res [search -s -n -f 0 -r 1 -l 0 "$startPara" $pos]
  201.     if {![string length $res] || $res == "0 0" } {return 0}
  202.     if { [lindex $res 0] == $pos } {
  203.         return $pos
  204.     } else {
  205.         return [nextLineStart [lindex $res 0]]
  206.     }
  207.     
  208. }
  209.  
  210. set texParaCommands {\[|\]|begin|end|(protect\\)?label|(sub)*section|subfigure|paragraph|centerline|centering|caption|chapter|item|bibitem|intertext}
  211. # The variable htmlParaCommands is defined in html.tcl.
  212. proc paraFinish {pos} {
  213.     global mode texParaCommands htmlParaCommands
  214.     set pos [lineStart $pos]
  215.     set end [maxPos]
  216.     if { $mode == "TeX" || $mode == "Bib" } {
  217.         set endPara {^[ \t]*$|\$\$[ \t]*$|^[ \t]*(\\(}
  218.         append endPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  219.     } elseif {$mode == "HTML"} {
  220.         set endPara {^[ \t]*$|</?(}
  221.         append endPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  222.     } else {
  223.         set endPara {^([ \t]*|([\\%].*))$}
  224.     }
  225.     
  226.     set res [search -s -n -f 1 -r 1 -l $end "$endPara" $pos]
  227.     if {![string length $res]} {return $end}
  228.     set cpos [lineStart [lindex $res 0] ]
  229.     if { $cpos == $pos } {
  230.         return [nextLineStart $cpos]
  231.     }
  232.     # A line which ends in '\\', '%...', '\hline', '\hhline'
  233.     # signifies the end of the current paragraph in TeX mode
  234.     # (the above checked for beginning of the next paragraph).
  235.     if { $mode == "TeX" || $mode == "Bib" } {
  236.         set res2 [search -s -n -f 1 -r 1 -l $end {((\\\\|\\h+line)[ \t]*|%.*)$} $pos]
  237.         if [string length $res2] {
  238.             if { [lindex $res2 0] < $cpos } {
  239.                 return [nextLineStart [lindex $res2 0]]
  240.             }
  241.         }
  242.     }
  243.  
  244.     return $cpos
  245.     
  246. }
  247.  
  248.  
  249. proc sentenceParagraph {} {
  250.     set pos [getPos]
  251.     set start [paraStart $pos] 
  252.     set finish [paraFinish $pos]
  253.  
  254.     set t [string trim [getText $start $finish]]
  255.     set period [regexp {\.$} $t]
  256.     regsub -all "\[ \t\r\]+" $t " " text
  257.     regsub -all {\. } $text "Δ" text
  258.     set result ""
  259.     foreach line [split [string trimright $text {.}] "Δ"] {
  260.         if {[string length $line]} {
  261.             append result [breakIntoLines $line] ".\r"
  262.         }
  263.     }
  264.     if {!$period && [regexp {\.\r} $result]} {
  265.         set result [string trimright $result ".\r"]
  266.         append result "\r"
  267.     }
  268.     if {$result != [getText $start $finish]} {
  269.         replaceText $start $finish $result
  270.     }
  271.     goto $pos
  272. }
  273.  
  274. proc getEndpts {} {
  275.     if {[getPos] == [selEnd]} {
  276.         set start [getPos]
  277.         set finish [getMark]
  278.         if {$start > $finish} {
  279.             set temp $start
  280.             set start $finish
  281.             set finish $temp
  282.         }
  283.     } else {
  284.         set start [getPos]
  285.         set finish [selEnd]
  286.     }
  287.     return [list $start $finish]
  288. }
  289.  
  290.  
  291. proc fillRegion {} {
  292.     global leftFillColumn
  293.     set ends [getEndpts]
  294.     set start [lineStart [lindex $ends 0]]
  295.     set finish [lindex $ends 1]
  296.     goto $start
  297.     set text [fillText $start $finish]
  298.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  299. }
  300.     
  301. proc wrapParagraph {} {
  302.     set pos [getPos]
  303.     set start [paraStart $pos] 
  304.     set finish [paraFinish $pos]
  305.     goto $start
  306.     wrapText $start $finish
  307.     goto $pos
  308. }
  309.  
  310. proc wrapRegion {} {
  311.     set ends [getEndpts]
  312.     set start [lineStart [lindex $ends 0]]
  313.     set finish [lindex $ends 1]
  314.     if {$start == $finish} {
  315.         set finish [maxPos]
  316.     }
  317.     wrapText $start $finish
  318. }
  319.     
  320.  
  321.  
  322. # Remove text from window, transform, and insert back into window.
  323. proc fillText {from to} {
  324.     global doubleSpaces
  325.     set text [getText $from $to]
  326.     regexp {^ *} $text front
  327.     set text [string trim $text]
  328.     regsub -all "\[ \t\r\]+" $text " " text
  329.     if {$doubleSpaces} {regsub -all {(\.|\?|\!) } $text {\1  } text}
  330.     regsub -all "\r" [string trimright [breakIntoLines $text]] "\r${front}" text
  331.     return $front$text
  332. }
  333.  
  334. proc paragraphToLine {} {
  335.     global fillColumn
  336.     global leftFillColumn
  337.     set fc $fillColumn
  338.     set lc $leftFillColumn
  339.     set fillColumn 10000
  340.     set leftFillColumn 0
  341.     fillRegion
  342.     set fillColumn $fc
  343.     set leftFillColumn $lc
  344. }
  345.  
  346. proc lineToParagraph {} {
  347.     global fillColumn
  348.     global leftFillColumn
  349.     set fc $fillColumn
  350.     set fillColumn 75
  351.     set lc $leftFillColumn
  352.     set leftFillColumn 0
  353.     fillRegion
  354.     set fillColumn $fc
  355.     set leftFillColumn $lc
  356. }
  357.  
  358.  
  359. #set sentEnd {[.!?](\r| +)}
  360. set sentEnd {(\r\r|[.!?](\r| +))}
  361. set sentBeg {[\r ][A-Z]}
  362.  
  363. proc nextSentence {} {
  364.     global sentBeg sentEnd
  365.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  366.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  367.             goto [expr [lindex $mtch 0]+1]
  368.         }
  369.     }
  370. }
  371.  
  372.  
  373. proc prevSentence {} {
  374.     global sentBeg sentEnd
  375.     if {[catch {search -s -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
  376.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  377.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  378.             goto [expr [lindex $mtch 0]+1]
  379.         }
  380.     }
  381. }
  382. # 5 730 845 955
  383.  
  384. #===============================================================================
  385. # Called by Alpha to do "soft wrapping"
  386. proc softProc {pos start next} {
  387.     global leftFillColumn
  388.     goto $start
  389.     set finish [paraFinish $start]
  390.     set text [fillText $start $finish]
  391.     if {"${text}\r" != [getText $start $finish]} {
  392.         replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  393.         return 1
  394.     } else {
  395.         return 0
  396.     }
  397. }
  398.  
  399.  
  400.